home *** CD-ROM | disk | FTP | other *** search
- (*
- UNCRUSH 0.61 - Public Release
- Designed and created by Bill Davidson
-
- NOTE : Please view the documentation. This program will not execute
- properly without a preset file name.
-
- This is Freeware. Please distribute.
-
- *)
-
-
- uses dos,crt; { Standard procedure that I always add... }
-
- const VIIImax = 100;
- VIImax = 100;
- VImax = 100;
- Vmax = 100; { Setting the array maximums }
- IVmax = 100;
- IIImax = 100;
- theoffset = 145; { This is a length to push the code character
- into the extended ASCII set }
-
- type VIIIarray = array[1..VIIImax] of string[8];
- VIIarray = array[1..VIImax] of string[7];
- VIarray = array[1..VImax] of string[6];
- Varray = array[1..Vmax] of string[5]; { Defining the arrays }
- IVarray = array[1..IVmax] of string[4];
- IIIarray = array[1..IIImax] of string[3];
- asciiarray = array[1..100] of char;
- chrarray = array[1..6] of char;
- const
- VIIIlist: VIIIarray = (' ',' of the ','@ ','--------',' in the ',' pointer','tion of ',' to the ','tructure',
- 'structur','@@~ ','ing the ',' structu','haracter','e of the','lgorithm','characte',' process',
- 'that the',' charact',' that th','@@ ',' program','compress','s of the','rocessor','language',
- 'pointers','algorith','program ',' languag',' can be ',' for the','for the ','ation of','function',
- ' compres','epresent','@Figure ',' on the ','hat the ',' algorit','represen','entation','mplement',
- 'and the ','ormation','formatio',' the pro',' recursi',' functio',' and the','ubprogra',' represe',
- 'subprogr','ion of t','implemen','ompressi','n of the','on of th','nformati','________','ocessor ',
- ' example','ructures',' subprog','rom the ',' from th','from the','t of the','with the','pression',
- 'of the s',' impleme','@@@@@@@@',' with th','position','variable','ould be ',' number ','mpressio',
- 'pointer ','nstructi','ictionar','omponent',' is the ','dictiona','ctionary','putation','consider',
- 'componen','processo','ointers ','ed in th','ith the ','computat','mputatio','umber of','truction',
- 'database');
-
- VIIlist: VIIarray = (' ',' of the','of the ','@ ','_______','in the ',' in the',' which ','to the ',' to the',
- 'program','ion of ','pointer','tion of',' pointe','ing the','tructur','ructure','ng the ','@@ ',
- '@@~ ','@~ ','s that ','e of th',' the co','process','present','at the ','aracter','lgorith',
- 'gorithm','anguage','and the','that th','ompress',' the st','hat the','can be ','s of th',' that t',
- 'e that ',' string','ations ','Figure ','rogram ','or the ','for the',' for th',' scheme',' can be',
- 'on the ','ointers',' the pr','ocessor','nd the ',' follow','@Figure',' on the','ation o',' number',
- ' to be ',' and th','unction',' compre','recursi','the pro',' the re','ntation','nstruct','. The ',
- 'mplemen',' sub i%','plement',' other ','formati','tional ','tation ','rmation',' comput',' recurs',
- 'n of th','es the ','rom the',' there ','with th','t of th','from th',' would ',' repres','on of t',
- '-------',' first ','example','@@@@@@@',' subpro','mpressi','.@This ',' from t','cessor ','ould be');
-
- VIlist: VIarray = (' ',' of th',' that ','f the ',' the s','@ ','ation ',' the c','s the ','in the',' this ',
- 'e the ',' in th','which ','______',' point','t the ',' with ','struct','to the',' which',' the p',
- 'rogram','o the ',' to th','@@ ','ion of','tions ','ing th','tion o','pointe','on of ','ointer',
- '.@The ','rocess','ations','tation','s are ','at the','ction ',', and ','s that',' the f','s and ',
- 'ructur',' proce','the co','ucture','r the ',' have ','~ ','g the ','d the ','@~ ','e of t',
- ' will ',' the t','nd the','string',' the l','and th','lement','ed by ','ed to ',' struc','presen',
- ' the a','ed in ','resent','e that',' the r','other ',' the r','other ',' the n',' sub i','hat th',
- 'racter','gorith','orithm','that t','can be','the st','ection',' The ','or the',' other','nguage',
- 'mpress','s of t',' the o','there ',' the e','for th','an be ','on the','Figure',' of a ','------',
- '. The ');
-
- Vlist: Varray = (' ',' the ',' and ','tion ','ation','of th',' of t',' that','f the','that ','@ ','n the',' sub ',
- 'ction','s of ',' for ','the s',' comp','s the',' are ','the c','e the','e of ','tions',' with','in th',
- 't the','ing t',' this','this ','which','with ',' in t','point',' the@','inter','to th','hich ','_____',
- 'the p','ther ','truct','o the','.@The','@The ',' to t','struc','@the ','here ','s to ','ion o','ions ',
- 't of ','@and ','@@ ','ting ',' not ','ng th','ogram','ition','n of ','t is ','d the','on of','ement',
- ' from',' can ','from ','other','ointe',' cont','progr',' of a','s are',' one ','at th','ed in','ding ',
- 'he co','e is ','r the','g the','proce','ocess','d to ',', and','ould ',' is a','cture','s and','the f',
- ', the','ing a','nd th',' have','s tha','and t','have ','will ',' The ');
-
- IVlist: IVarray = (' ',' the','the ',' of ','tion','ing ','and ',' to ',' and',' is ','ion ',' in ','that','f th',' tha',
- 'atio','hat ','of t','n th',' sub','@ ','s th',' for','e th','his ',' pro','ther',' com','for ',' be ',
- ' con','sub ','s of','he s','comp','The ','are ',' are','he c','t th','with','ent ','e of','ions',' thi',
- 'e co','ment','.@Th','in t','ted ','inte','@the','nter','this','@The',' wit','ng t','ter ','here',' as ',
- 'mple','o th','her ','ith ','pres','@and',' str','hich','ting','to t','oint',' not','d th','he p','the@',
- 'ere ','ding','ring',' by ','s a ',' it ','____','ich ',' whi','s to','s in','cess','form','s an','t th',
- 'is a','gram','ed t','ture','one ','t of',' poi','t is','----','oice');
-
- IIIlist: IIIarray = (' ',' th','the','he ',' of','of ','ing','ion','is ','and','tio',' an','nd ',' in','ed ',' to','to ',
- 'ng ',' co','er ','on ','es ',' a ','re ',' is','ent','in ','s a','e t','or ','ter',' re',' su','at ',
- 's t','for',' be','ati','@@~','hat','tha','e s','e a','n t','al ','her','f t','res','pro','e c',' fo',
- ' pr','s o',' st','e o','as ','sub','. ','all','en ','on ','con','are','ess','his','ly ','e i','The',
- 'ch ',' no','@ ','t t','ith','omp','ons','int','nte','ll ',' ar','ere',' de','cti','be ','ver','nt ',
- 'st ','d t','ers',' wi',' wh','str','e p','nce','ts ',' ma','ate','@th','thi','---','. T');
-
- chrlist: chrarray = (chr(1),chr(2),chr(3),chr(4),chr(5),chr(6));
-
- { Those compose my compression dictionary from which I uncode for }
-
-
- var
- f,j : text;
- b5,b4,b6,b7,b8,a5 : integer;
- s : string[160];
- a1,d1 : integer; { Defining varibles }
- chra,length1 : integer;
- label endloopa1,startloop,endloop;
-
- (********************* Procedures ***************************)
-
- { The start of the engine is at the bottom, below the procedures }
-
- procedure gram8;
- var
- c1 : string[1];
- c : char;
- a2,d1 : integer;
- a3 : string[8];
- label start8;
-
- begin;
- start8:
- c1 := copy(s,a1+1,1); { After reaching a header character, it goes
- to the code character, which is to the right
- one character. }
- c := c1[1]; { Getting the ASCII character }
- a2 := ord(c); { Receiving the ordinal value of 'c' }
- a3 := VIIIlist[a2-theoffset]; { Removing the offset number placed during
- compression and getting the
- cooresponding array string }
- delete(s,a1,2); { Deleting the header and code characters }
- insert(a3,s,a1); { Inserting the string where the header
- character was }
- d1 := 8; { Since I put in an 8 character string, the
- pointer on the line needs to skip that
- string by advancing 8 characters }
- end; { Return to main procedure }
-
- (********************* 7 *********************)
-
- procedure gram7;
- var
- c1 : string[1];
- c : char;
- a2,d1 : integer;
- a3 : string[7];
- label start7;
-
- begin;
- start7:
- c1 := copy(s,a1+1,1); { Same as 8 }
- c := c1[1];
- a2 := ord(c);
- a3 := VIIlist[a2-theoffset];
- delete(s,a1,2);
- insert(a3,s,a1);
- {goto start7;}
- d1 := 7;
- end;
-
- (************************* 6 ************************)
- procedure gram6;
- var
- c1 : string[1];
- c : char;
- a2,d1 : integer;
- a3 : string[6];
- label start6;
-
- begin;
- start6:
- c1 := copy(s,a1+1,1);
- c := c1[1];
- a2 := ord(c);
- a3 := VIlist[a2-theoffset];
- delete(s,a1,2);
- insert(a3,s,a1);
- {goto start6;}
- d1 := 6;
- end;
-
- (************************* 5 *******************************)
- procedure gram5;
- var
- c1 : string[1];
- c : char;
- a2,d1 : integer;
- a3 : string[5];
- label start5;
-
- begin;
- start5:
- c1 := copy(s,a1+1,1);
- c := c1[1];
- a2 := ord(c);
- {writeln(s,' ',c,' ',a2,' ',a3);}
- a3 := Vlist[a2-theoffset];
-
- delete(s,a1,2);
- insert(a3,s,a1);
- {goto start5;}
- d1 := 5;
- end;
-
- (********************** 4 ************************)
- procedure gram4;
- var
- c1 : string[1];
- c : char;
- a2,d1 : integer;
- a3 : string[4];
- label start4;
-
- begin;
- start4:
- c1 := copy(s,a1+1,1);
- c := c1[1];
- a2 := ord(c);
- a3 := IVlist[a2-theoffset];
- delete(s,a1,2);
- insert(a3,s,a1);
- {writeln('s=',s,'*length1=',length1);}
- {goto start4;}
- d1 := 4;
- end;
-
- (************************ 3 **************************)
- procedure gram3;
- var
- c1 : string[1];
- c : char;
- a2,d1 : integer;
- a3 : string[3];
- label start3;
-
- begin;
- start3:
- c1 := copy(s,a1+1,1);
- c := c1[1];
- a2 := ord(c);
- a3 := IIIlist[a2-theoffset];
- delete(s,a1,2);
- insert(a3,s,a1);
- {goto start3;}
- d1 := 3;
- end;
-
- {
- End of the Procedures of Compression
- }
-
- begin
- assign(f,'w.w'); { Assigning 'f' to the coded file }
- reset(f); { Opening the coded file }
- assign(j,'e.e'); { Assigning 'j' to the output file }
- rewrite(j); { Open 'j' for writing }
- while not eof(f) do { Work until we reach the end of file marker }
- begin { Begin looking at a line }
- readln(f,s); { Read a line }
- d1 := 0; { This is a variable that advances the pointer,
- or a1 }
- length1 := length(s); { Get the length of the line }
- for chra := 249 to 254 do { Begin looking for header characters }
- begin
- a1 := 0; { This is the pointer that records the position
- on the line }
- startloop:
- a1 := a1 + 1; { Advance the pointer to the next character }
- if a1 > length1 then goto endloop; { Check to see if it has reached the
- end of the line }
- begin
- if chr(chra) = s[a1] then { If you find the character... }
- begin
- if chr(chra) = s[a1+1] then {... and it has a twin, then...}
- begin
- delete(s,a1,1); { Delete the twin }
- goto endloopa1;
- end;
-
- case chra of { If it doesn't have a double then begin
- uncoding }
- 249: gram8;
- 250: gram7;
- 251: gram6;
- 252: gram5;
- 253: gram4;
- 254: gram3;
- end; { End case }
- a1 := a1 + d1; { Advance the pointer past the uncoded string }
- end; { end "if chr(chra) = s[a1] then" }
- endloopa1:
- length1 := length(s);
- goto startloop;
- endloop:
- end; { end "for a1 1 to length1 do" }
- end; { end "for chra 249 to 254 do" }
-
-
- writeln(j,s); { Write the uncoded line to the output file }
- end; { end program }
- close(j); { Save 'j' }
- end.